home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-05
/
pcprl11.zip
/
DEVMAN.PLS
< prev
next >
Wrap
Text File
|
1992-02-06
|
5KB
|
230 lines
program devman;
{$N+,E+,F+}
uses dos, crt, both,work, graph;
const
num_colu = 2;
num_proc = 1;
type
complex = record
realp,
imag : double;
end;
resu = array[1..200*num_colu] of integer;
var
gap1,
gap2 : double;
bcorner : complex;
i,
j,
cur_col,
num_col,
pix_col,
start_col,
tot_col : integer;
results : resu;
graphdriver,
graphmode : integer;
procedure start_up;
begin
exitsave := exitproc;
exitproc := @myexit;
master[1] := $00;
master[2] := $00;
master[3] := $C0;
master[4] := $05;
master[5] := $86;
master[6] := $24;
init_system;
end;
procedure adder;
type
complex = record
realp,
imag : double;
end;
var
gap1, gap2,
a,b,c,
size : double;
bcorner,
ncomplex,
original : complex;
cur_col,
tot_col,
num_col,
pix_col,
cc,
row,
r,
indexc,
result,
start_col,
end_col : integer;
results : array[1..200*num_colu] of integer;
finished : boolean;
begin
in ( 'stuff', gap1, gap2, bcorner );
in ( 'screen', cur_col, tot_col, pix_col, num_col );
if cur_col > tot_col then
begin
finished := true;
end
else
begin
finished := false;
start_col := cur_col;
end_col := cur_col + num_col - 1;
cur_col := cur_col + num_col;
end;
out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
while not finished do
begin
indexc := 0;
for cc := start_col to end_col do
begin
for r := 1 to pix_col do
begin
ncomplex.realp := cc * gap1 + bcorner.realp;
ncomplex.imag := r * gap2 + bcorner.imag;
result := 0;
size := 0.0;
original.realp := 0.0;
original.imag := 0.0;
while ( result <= 210 ) and ( size < 4.0 ) do
begin
a := original.realp * original.realp;
b := original.realp * original.imag;
c := original.imag * original.imag;
original.realp := a-c+ncomplex.realp;
original.imag := b+b+ncomplex.imag;
size := original.realp*original.realp+original.imag*original.imag;
inc ( result );
end;
results[indexc+r] := result;
end;
indexc := indexc+pix_col;
end;
out ( 'col', &start_col, &results );
in ( 'screen', cur_col, tot_col, pix_col, num_col );
if cur_col > tot_col then
begin
finished := true;
end
else
begin
start_col := cur_col;
end_col := cur_col + num_col-1;
cur_col := cur_col + num_col;
end;
out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
end;
end;
procedure plot ( col : integer; results : resu );
var i,j : integer;
color : word;
begin
for j := 0 to num_col-1 do
for i := 1 to 200 do
begin
if results[i+j*200] < 20 then color := 1;
if results[i+j*200] > 20 then color := 9;
if results[i+j*200] > 40 then color := 2;
if results[i+j*200] > 60 then color := 10;
if results[i+j*200] > 80 then color := 4;
if results[i+j*200] > 100 then color := 12;
if results[i+j*200] > 120 then color := 5;
if results[i+j*200] > 140 then color := 13;
if results[i+j*200] > 160 then color := 8;
if results[i+j*200] > 180 then color := 7;
if results[i+j*200] > 200 then color := 0;
putpixel ( col+j , i, color );
end;
end;
begin
start_up;
graphdriver := vga;
graphmode := vgahi;
initgraph ( graphdriver, graphmode, 'a:' );
gap1 := 2.50 / 320;
gap2 := 2.50 / 200;
bcorner.realp := -2.0;
bcorner.imag := -1.25;
cur_col := 1;
tot_col := 320;
pix_col := 200;
num_col := num_colu;
for i := 1 to num_proc do
begin
eval ( 'work', &adder );
out ( 'stuff', &gap1, &gap2, &bcorner );
end;
out ( 'screen', &cur_col, &tot_col, &pix_col, &num_col );
for i := 1 to tot_col div num_col do
begin
in ( 'col', start_col, results );
plot ( start_col, results );
end;
in ('screen', cur_col, tot_col, pix_col, num_col );
readln;
{ system_shutdown }
close_system
end.